home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / ra / frmv21.zip / FREMOVE.PAS < prev   
Pascal/Delphi Source File  |  1994-05-17  |  9KB  |  224 lines
  1. Program FileRemover; {FileRemover v2.1}
  2. Uses Dos,Crt;
  3. Type
  4.     FlagType       = array[1..4] of Byte;
  5.     FILESrecord    = record
  6.                      Unused         : Array[1..4] of Byte;
  7.                      Name           : String[40];
  8.                      Attrib         : Byte;
  9.                      FilePath       : String[40];
  10.                      KillDaysDL,
  11.                      KillDaysFD     : Word;
  12.                      Password       : String[15];
  13.                      MoveArea       : Word;
  14.                      Age,
  15.                      ConvertExt     : Byte;
  16.                      Group          : Word;
  17.                      Attrib2        : Byte;
  18.                      DefCost,
  19.                      UploadArea,
  20.                      UploadSecurity : Word;
  21.                      UploadFlags,
  22.                      UploadNotFlags : FlagType;
  23.                      Security       : Word;
  24.                      Flags,
  25.                      NotFlags       : FlagType;
  26.                      ListSecurity   : Word;
  27.                      ListFlags,
  28.                      ListNotFlags   : FlagType;
  29.                      AltGroup       : Array[1..3] of Word;
  30.                      Device         : Byte;
  31.                      FreeSpace      : Array[1..13] of Byte;
  32.     End;
  33. Procedure Exit(G:String); {Halting Procedure}
  34. Begin
  35.      writeln(g);
  36.      halt;
  37. End;
  38. Const
  39.      UnreadOnly       : Byte=$FE;
  40.      NotFirst         : Boolean=False;
  41.      Prog             : String='FileRemover';
  42.      Ver              : String='v2.1';
  43.      Typ              : String='Freeware';
  44.      By               : String='Yair Softwares';
  45. Var
  46.    F,G                : Text;
  47.    FMask,FName,T      : String[12];
  48.    Em                 : String[2];
  49.    FN                 : Namestr;
  50.    EN                 : Extstr;
  51.    DS                 : Dirstr;
  52.    DT,OT              : Datetime;
  53.    SRec               : Searchrec;
  54.    NewF               : String[12];
  55.    OldF               : Array [1..1000] of String[12];
  56.    AreaI              : Array [1..200] of Integer;
  57.    AreaF              : File of Filesrecord;
  58.    Area               : Filesrecord;
  59.    NoFile,Ign         : Boolean;
  60.    Match,Ex,Pr        : Boolean;
  61.    I,A,B,Res,C,D,E    : Integer;
  62.    St,Ft              : String;
  63.    Attr               : Word;
  64.    Fl                 : File;
  65. Begin
  66.      Textcolor(7);
  67.      Textbackground(0);
  68.      Writeln(Prog,' ',ver,' by ',by,' (',typ,')');
  69.      Writeln;
  70.      I:=0;
  71.      If Paramcount<>1 then Exit('No FileMask Specified...');
  72.      FMask:=Paramstr(1);
  73.      Assign(F,'AREAS.IGN');
  74.      {$I-}Reset(F);{$I+}
  75.      Res:=IOResult;
  76.      If (Res<>0) and (Res<>2) then Exit('Error reading Ignored Areas List...');
  77.      d:=0;
  78.      If Res=0 then
  79.      Repeat
  80.            Readln(F,St);
  81.            d:=d+1;
  82.            Val(St,AreaI[d],e);
  83.      Until Eof(F);
  84.      If Res=0 then Close(f);
  85.      Filemode:=0 + $40;
  86.      Assign(AreaF,Getenv('RA')+'\FILES.RA');
  87.      {$I-}Reset(AreaF);{$I+}
  88.      Filemode:=2;
  89.      If IOResult<>0 then Exit('Error reading FILES.RA ...');
  90.      c:=0;
  91.      Repeat
  92.            {$I-}Read(AreaF,Area);{$I+}
  93.            If IOResult<>0 then Exit('Error reading FILES.RA ...');
  94.            c:=c+1;
  95.            writeln;
  96.            write('Area ',c,': ',area.name);
  97.            Pr:=True;
  98.            For e:=1 to d do If C=AreaI[E] then Pr:=False;
  99.            If Pr then
  100.            Repeat
  101.                  Nofile:=False;
  102.                  Findfirst(Area.Filepath+'\'+FMask,Anyfile,Srec);
  103.                  If Doserror<>0 then NoFile:=True;
  104.                  While Doserror=0 do
  105.                  Begin
  106.                       With Srec do
  107.                       Begin
  108.                            Unpacktime(Time,DT);
  109.                            With dt do
  110.                            Begin
  111.                                 Match:=False;
  112.                                 If Notfirst then
  113.                                 Begin
  114.                                      If Dt.Year>Ot.Year then Match:=True
  115.                                      Else If Dt.Year=Ot.Year
  116.                                      Then If Dt.Month>Ot.Month then Match:=True
  117.                                      Else If Dt.Month=Ot.Month
  118.                                      Then If Dt.Day>Ot.Day then Match:=True
  119.                                      Else If Dt.Day=Ot.Day
  120.                                      Then If Dt.Hour>Ot.Hour then Match:=True
  121.                                      Else If Dt.Hour=Ot.Hour
  122.                                      Then If Dt.Min>Ot.Min then Match:=True
  123.                                      Else If Dt.Min=Ot.Min
  124.                                      Then If Dt.Sec>Ot.Sec then Match:=True;
  125.                                 End
  126.                                 Else Match:=True;
  127.                                 If Match then
  128.                                 Begin
  129.                                      If Notfirst then I:=I+1;
  130.                                      If Notfirst then OldF[I]:=NewF;
  131.                                      Ot:=Dt;
  132.                                      FSplit(name,DS,FN,EN);
  133.                                      NewF:=FN+EN;
  134.                                 End
  135.                                 Else
  136.                                 Begin
  137.                                      I:=I+1;
  138.                                      FSplit(name,DS,FN,EN);
  139.                                      OldF[I]:=FN+EN;
  140.                                 End;
  141.                            End;
  142.                       End;
  143.                       Findnext(Srec);
  144.                       Notfirst:=True;
  145.                  End;
  146.                  Ign:=False;
  147.            Until Doserror<>0
  148.            Else
  149.            Begin
  150.                 Nofile:=True;
  151.                 write(' - Area Ignored');
  152.                 Ign:=True;
  153.            End;
  154.            If not Ign then
  155.            If Not NoFile then
  156.            Begin
  157.                 Assign(F,Area.Filepath+'\FILES.BBS');
  158.                 {$I-}Reset(F);{$I+}
  159.                 If IOResult<>0 then Exit('Error reading '+Area.Filepath+'\FILES.BBS ...');
  160.                 Assign(G,Area.Filepath+'\FILES.$$$');
  161.                 {$I-}Reset(G);{$I+}
  162.                 If IOResult=0 then Erase(G);
  163.                 Rename(F,Area.Filepath+'\FILES.$$$');
  164.                 Assign(F,Area.Filepath+'\FILES.$$$');
  165.                 Reset(F);
  166.                 Assign(G,Area.Filepath+'\FILES.BBS');
  167.                 Rewrite(G);
  168.                 Repeat
  169.                       Readln(F,St);
  170.                       T:='            ';
  171.                       T:=st;
  172.                       FName:='';
  173.                       For a:=1 to 12 do if T[A]<>' ' then Fname:=Fname+T[a];
  174.                       Ex:=False;
  175.                       For a:=1 to i do If Fname=OldF[a] then Ex:=True;
  176.                       If Ex then
  177.                       Begin
  178.                            writeln;
  179.                            Write('Erasing ',fname,' from FILES.BBS');
  180.                            Repeat
  181.                                  Readln(F,St);
  182.                                  Em:=St;
  183.                            Until (Em<>' +') and (Em<>'+ ');
  184.                       End;
  185.                       Writeln(G,st);
  186.                 Until EOF(F);
  187.                 Close(F);
  188.                 Close(g);
  189.                 B:=0;
  190.                 While B<>I do
  191.                 Begin
  192.                      B:=b+1;
  193.                      Assign(Fl,Area.Filepath+'\'+OldF[B]);
  194.                      {$I-}Reset(Fl);{$I+}
  195.                      Res:=IOResult;
  196.                      Case Res of
  197.                           0:
  198.                           Begin
  199.                                Erase(Fl);
  200.                                Writeln;
  201.                                Write(OldF[B],' Erased...');
  202.                           End;
  203.                           5:
  204.                           Begin
  205.                                Assign(Fl,Area.Filepath+'\'+OldF[B]);
  206.                                GetFattr(Fl,Attr);
  207.                                SetFAttr(Fl,Attr and Unreadonly);
  208.                                Assign(Fl,Area.Filepath+'\'+OldF[B]);
  209.                                Reset(Fl);
  210.                                Erase(Fl);
  211.                                Writeln;
  212.                                Write(OldF[B],' Erased...');
  213.                           End;
  214.                      End
  215.                 End;
  216.            End
  217.            Else write(' - No files Found...');
  218.      Until EOF(AreaF);
  219.      Close(AreaF);
  220.      writeln;
  221.      writeln;
  222.      writeln(prog,' ',ver,' - DONE!');
  223. end.
  224.